﻿Imports 地图商家采集系统

Public Class CMapTengXun
    Inherits CMap
    Implements IMap
    Public Sub New(mapTask As Model_Task, callback As Action(Of CProductInfo))
        task = mapTask
        Me.UpdateView = callback
    End Sub
#Region "腾讯采集方法"
    Public Sub Deal() Implements IMap.Deal
        Log($"{MapMode.TengXun.GetDescription}信息解析中...")
        Dim areas = task.Areas
        For Each area In areas
            Dim wd = area.City
            If wd.IsNullOrEmpty() Then wd = area.Country
            Dim code = GetCode(wd)
            GetProducts(code, wd)
            ''通过城市码得到HTML,并获取列表页相关信息类BaiDuListInfo
            'GetBaiduProducts(code, area.City)
        Next
    End Sub
    'Private Function HasFilterKeyword(k As CKeyword) As Boolean
    '    If Not task.FilterKeywords.Count = 0 Then
    '        For Each ff In task.FilterKeywords
    '            If k.ToString = ff.ToString Then
    '                Return True
    '            End If
    '        Next
    '    End If
    '    Return False
    'End Function
    Private Sub GetProducts(code As String, city As String)
        Dim keywords = task.KeyWords
        For Each k As CKeyword In keywords
            Dim FlagPageEnd As Boolean = False, Page = -1
            Dim infoCount As Integer = 0
            Dim prePage As String = ""
            Dim success As Integer = 0
            Do
                success = 0
                Page += 1
                Dim cityName = Uri.EscapeDataString(city)
                Dim kw As String = Uri.EscapeDataString(k.Keyword)
#Region "正常模式采集"
                '1.先获取城市坐标
                'https://router.map.qq.com/cc?qt=cc&c=%E5%8D%97%E4%BA%AC&lc=3&output=jsonp&cb=QQMapLoader.cb1056457928
                Dim PostionHtml As Sy.String = Sy.Net.Factory.Http($"https://router.map.qq.com/cc?qt=cc&c={cityName}&lc=3&output=jsonp&cb=QQMapLoader.cb1056457928").Get()
                Dim SpliterXS = """pointx"":""", SpliterE = """", SpliterYS = """pointy"":"""
                If PostionHtml.IsNullOrEmpty() Then 
                    Log("采集超时异常")
                    Exit Do
                End If
                If Not PostionHtml.CanMid(SpliterXS, SpliterE) OrElse Not PostionHtml.CanMid(SpliterYS, SpliterE) Then
                    SpliterXS = """pointx"": """
                    SpliterYS = """pointy"": """
                    
                    If Not PostionHtml.CanMid(SpliterXS, SpliterE) OrElse Not PostionHtml.CanMid(SpliterYS, SpliterE) Then
                        Log("采集超时异常")
                        Exit Do
                    End If
                End If
                Dim PostionX = PostionHtml.Mid(SpliterXS, SpliterE)
                Dim PostionY = PostionHtml.Mid(SpliterYS, SpliterE)
                '1.获取请求URL中的ti和ck
                Dim PostData = "aid=9309233&sid=7806674910925136669&data=BOpeLqsyH1heXk02ZENgieMAs26CS9HlmLGoFV0T-Z255Im1IOHlmr9q57BE4YVxKITjsEZzK5xVXl62a9ErnFVeXk7ONeCrN2hlovTnPn6Ka7N44bEtzs1U1J8C7kO2xCiFNmVOgBgV39wuZuUic9XJN6T1aOXnOGhONNf6aMdyTmXjcN3Qu6-kw1xTj6wp5aKcuwJuSTPYlecubI5qMlCVjfGEsrjEh7TEKJE6h27OBKc41Z-UakQyaNWPPL3vZgLYjzC6bqd4Rb066sf-rZZy_MwwJMfTzPj0FrwPQNj9jb3nM1h9-Lu7byMY0puyrTGzVd2R4etxcltcbZWSu8Vzcv3HOe3Ghzjgl5RtLTIITdk1vYJTCTFk5HJxY-RrKpydxGFeXnZwkS6_b3Mo9ZeUb8WHeH3VL2oER8lF2Tlpbac4cIE-OAYzQlDJOWgvMGiQz5VuBJPIVdGbaAVTaV5eXl4ejBZA3lncXkBCXCZ-FlxeXl72dIuGnBt1bC6q7CUCKI0ftWzCA8hdXm6qakeokOn1B7_vc2vB4W77qyYwG_-PeIXo8OE9ZijVkJiJNWvsTBTteAtfWV5eXlvfQf3vPHIpw5M4H4E3OeYDuJUGbMjlkDjtgitoxUHN7zxytm1nc9m7PeruEPnhg_I3A4IQjc0wJsPA1O868kZTmNzvOnJGVZjc7z5yRlWY3O8-ckZVmNzvPHJGFZjMB0zeSWjRK5xVXl4-XO8eXhg_V5pcX0ZXe15VWj5qzF5yTt5HH1zuHl4Ym1aeXF9GR3xeVVo-KNpeck7eT1Rc7h5eGLdZ4lxfRvNAvlRaPrgo3nVO3o-KX_AeXhhKWeZcX0aLRb5UWj46N951Tt5PwF_wHl4wZX5Y5lxf5qdeRr5UWr6qXQDedU7eDU4uX_EeXhAc_lueXF9mT99LXlVavgpaDF5yTt6NTx5f7h5eEBa-WppcX2Z7X01OVVq--loUnnJO3o1Mfl_qHl4QEz5aitx-5q7fTw5V1r6cWRgec07e5UFGX-seXtDTflqGXF_mZ9xO3lVavqpWHJ5wTt5FekZf4B5eMM-eWl5dX2YU3Ep-Ulq-alcInm5O3kV7Ll-aHl4Qy35YSl1f5gdcRC5SWr4qVy6eb07eRXiGX5keXhDH_llCXV9mN1x-LlJavupX2p5vTt5NeXZcmR5eEMO-VkJdX2YkXHouUlq-qlfKXmxO3k12PlyXHl4w_15Udl1f5tRcdP5SWr5qVOiebM7aTXdO3kV3fl2SHl4Q-75Tbl1fZsdcYJ5SWr4qVExfbU7eTXSeWpIeXhD3HktyXV9m99w-_lJavupU8N9sTt59dTZZlB5eEPMefnZdX2bnXNL-Ulq-plQQ3GxO3kVy_leUHl4Q7352dl1f5pfc-c5SWr5qVeacb07eTXNmVZgeXvDrHnBSXV9mh1zgflJavipVTh1uTt5FcOZS4R5eMOd-a65cX2a3XILuVVq-6FXUHXDO2k1xTt5FccZQ6R5eEOP-ZYZcX-anXKt-VVq-qFW0nXVO3k1uplHzHl4Qn14f8lxfZlddVs9UWr5qUnDad07eTW-OTvoeXjCbnh3aXF9mR11PX1RaviZSEhp5xtpNbE7eTWweT8IeXhCXHhs6XF9md11Iz1davuZSBJp7Tt5Nbd5PyB5eEJN-GA5cX2Zk3UdvV1q-pFI22npO3k1q9k_PHl4Qj54YYlxfZhddQq9WWr5qUyoafcbaDWhO3n1phk_VHl4Qvj4ZdlxfZtvdQ99WWr54UCjaf07ejWaGT9oeXhC6PhlSXF9my91Df1ZavjhQKBp-Tt6NZ4ZP3h5eELY-GaZfX2b73UOfWVq-9lAo2kBO3o1khk8mHl4Qst4Zil9fZutdQB9ZWr66UCSaQk7ejWW2TyweXjCunhmeX1_mmt1BX1lavnpR3JpFTt6NYkZMMB5eEKqeFu5fX2aLXXrvWFq-OlHG2kRO3o1jzkw2Hl4wpl4Vxl9fZrtdbm9YWr76UYbaRk7ejWC2TQEeXhCi_gwyX19mq90JP1tavrhR1ttKTt6NYe5IER5e0F7_AmZfX-ZZWiefWlq-ek6mG0xO3o0efkYWHl4QWh8_Ql8-Zktb2y9a_r8ISty_bEtKmE9-2I0KDkYZXl5eXl5eXg**"
                Dim TempHtml As Sy.String = Sy.Net.Factory.Http("https://ssl.captcha.qq.com/getwt").SetData(PostData).Post()
                Dim SpliterTiS = """web_ticket"":""", SpliterTiE = """"
                If TempHtml.IsNotEmpty() AndAlso TempHtml.CanMid(SpliterTiS, SpliterTiE) Then
                    Dim Ti = TempHtml.Mid(SpliterTiS, SpliterTiE)
                    'qt=poi&c=320100&wd=%E7%81%AF%E9%A5%B0&pn=0&rn=20&bl=1&nj=0&nr=0&nf=1&l=12&b=118.65406011816407,32.19349740730506,118.88717626806641,31.95640119414311&rl=9&lc=4&nqc=0&owd=&qct=&md=&initiative=true&ref=pc_map&t=1616227987859&ck=&aid=0&ti=wt0VhMxgV8HEcv9vNWMPiXg1_P1rUu1-5U46QVU8ROhuYC0tq8lal7G9w**&output=jsonp&cb=QQMapLoader.cb_61335811563722749063120989798967
                    Dim url = $"https://search.map.qq.com/?qt=poi&c={code}&wd={kw}&pn={Page}&rn=20&bl=1&nj=0&nr=0&nf=1&l=12&b={PostionX},{PostionY},{Convert.ToDouble(PostionX) + 0.2},{Convert.ToDouble(PostionY) + 0.2}&rl=9&lc=1&nqc=0&owd=&qct=&md=&initiative=true&ref=pc_map&t={GetTimeStamp(TimestampMode.Millisecond)}&ck=d52a45783105a93008c4dd29d4235ebf&aid=0&ti={Ti}&output=jsonp&cb=QQMapLoader.cb_61335811563722749063120989798967"
                    Dim count As Integer = 1
                    Dim html As String = ""
                    Dim exp As Exception
                    Do
                        exp = Nothing
                        html = Sy.Text.Encode.RemoveEscape_HTML(
                            Sy.Text.Encode.RemoveEscape_Java(Sy.Net.Factory.Http(url).SetCookies("RK=WzLdVzUqdg; ptcz=be38ac41752e16f62db844e89ca37fd7fe70f05caae36b93c9de04569acb6658; pgv_pvid=8317638902; o_cookie=1303628841; pac_uid=1_1303628841; sd_userid=99261613960041613; sd_cookie_crttime=1613960041613; _tc_unionid=02b12f70-dac7-4980-a649-782cd224a17b; _qpsvr_localtk=0.85318321311738; uin=null; skey=null; luin=null; lskey=null; user_id=null; session_id=null; mpuv=273fb773-8e3c-4507-f1e2-ccf39da043f2; pgv_info=ssid=s9269914440").SetReferer("https://map.qq.com/").SetExceptionHandle(Function() exp).Get()))
                        count += 1
                    Loop While exp IsNot Nothing AndAlso count < 5
                    If exp Is Nothing Then
                        Dim arrSpliter = """uid"":"
                        If html.Length < 0 OrElse Not html.Contains(arrSpliter) OrElse prePage = html Then
                            Log("关键字：" & k.Keyword & "未采集到信息,请确认")
                            FlagPageEnd = True
                        Else
                            prePage = html
#Region "采集列表页信息"
                            Dim items = html.Split({arrSpliter}, StringSplitOptions.RemoveEmptyEntries)
                            For i = 1 To items.Count - 1
                                Dim item = items(i)
                                Dim address As String = ""
                                Dim area As String = ""
                                Dim workplane As String = ""
                                Dim title As String = ""
                                Dim phone As String = ""
                                Dim mobile As String = ""
                                Dim x As String = 0
                                Dim y As String = 0
#Region "地址"
                                Dim areaSpliter = """regions"":"""
                                If item.Contains(areaSpliter) Then area = Split(item, areaSpliter)(1).Split({""""}, StringSplitOptions.None)(0)
                                Dim addrSpliter = """addr"": """
                                If item.Contains(addrSpliter) Then address = Split(item, addrSpliter)(1).Split({""""}, StringSplitOptions.None)(0)
#End Region
#Region "坐标"
                                Dim xSpliter = """pointx"": "
                                Dim ySpliter = """pointy"": "
                                If item.Contains(xSpliter) Then x = Split(item, xSpliter)(1).Split({","}, StringSplitOptions.None)(0)
                                If item.Contains(ySpliter) Then y = Split(item, ySpliter)(1).Split({","}, StringSplitOptions.None)(0)
                                workplane = "X:" & x & "|Y:" & y
#End Region
#Region "标题"
                                Dim titleSpliter = """name"": """
                                If item.Contains(titleSpliter) Then title = Split(Split(item, titleSpliter)(1), """")(0)
#End Region

#Region "手机号"
                                Dim phoneSpliter = """phone"": """
                                If item.Contains(phoneSpliter) Then mobile = Split(item, phoneSpliter)(1).Split({""""}, StringSplitOptions.None)(0).Trim
                                '座机号
                                Dim telSpliter = """tel"":"""
                                If item.Contains(telSpliter) Then phone = Split(item, telSpliter)(1).Split({""""}, StringSplitOptions.None)(0).Trim
#End Region
#Region "访问详情页所需ID(备用，目前不需要,使用时，关闭注释即可)"
                                'Dim pid = ""
                                'Dim uid = ""
                                'If item.Contains(pidSpilter) Then
                                '    Dim temp = Split(item, pidSpilter)(1)
                                '    pid = Split(temp, """")(0)
                                '    If temp.Contains(uidSpliter) Then uid = Split(Split(temp, uidSpliter)(1), """")(0)
                                'End If
#End Region
#Region "采集过滤,添加"
#End Region
                                If FilterResult(title, phone, mobile, address) AndAlso FilterKeywordResult(title, task.FilterKeywords) Then
                                    Dim info = New CProductInfo(address, title, workplane, city, k.Keyword, MapMode.TengXun.GetDescription, url, phone, mobile, area)
                                    success += If(info.Add(), 1, 0)
                                    UpdateView(info)
                                End If
                            Next
#End Region
                            If items.Count <= 1 Then FlagPageEnd = True
                            If success = 0 Then FlagPageEnd = True
                        End If
                    Else
                        Log("采集超时异常")
                        FlagPageEnd = True
                    End If
                End If
#End Region
#Region "手机模式采集"
                '                '1.先获取城市坐标
                '                'https://router.map.qq.com/cc?qt=cc&c=%E5%8D%97%E4%BA%AC&lc=3&output=jsonp&cb=QQMapLoader.cb1056457928
                '                Dim PostionHtml As Sy.String = Sy.Net.Factory.Http($"https://router.map.qq.com/cc?qt=cc&c={cityName}&lc=3&output=jsonp&cb=QQMapLoader.cb1056457928").Get()
                '                Dim SpliterXS = """pointx"":""", SpliterE = """", SpliterYS = """pointy"":"""
                '                If PostionHtml.IsNotEmpty() AndAlso PostionHtml.CanMid(SpliterXS, SpliterE) AndAlso PostionHtml.CanMid(SpliterYS, SpliterE) Then
                '                    Dim PostionX = PostionHtml.Mid(SpliterXS, SpliterE)
                '                    Dim PostionY = PostionHtml.Mid(SpliterYS, SpliterE)
                '                    '2.获取搜索内容
                '                    Dim count As Integer = 1
                '                    Dim html As String = ""
                '                    Dim exp As Exception
                '                    Dim url = $"https://map.qq.com/m/place/result/city={cityName}&word={kw}&bound={PostionX},{PostionY},{Convert.ToDouble(PostionX) + 0.02},{Convert.ToDouble(PostionY) + 0.02}&page={Page}&cpos={Convert.ToDouble(PostionX) + 0.01},{Convert.ToDouble(PostionY) + 0.01}&mode=list%20?pagelets[]=poiresult&t=78291&access_token=964c6fbb9b466a8716c0ed210034abdb540da70934c66b57e38c4c86"
                '                    Do
                '                        exp = Nothing
                '                        html = Sy.Text.Encode.RemoveEscape_HTML(
                '                            Sy.Text.Encode.RemoveEscape_Java(Sy.Net.Factory.Http(url).SetCookies(cookies).SetUserAgent("Mozilla/5.0 (Linux; Android 6.0; Nexus 5 Build/MRA58N) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/89.0.4389.82 Mobile Safari/537.36").SetExceptionHandle(Function() exp).Get()))
                '                        count += 1
                '                    Loop While exp IsNot Nothing AndAlso count < 5
                '                    If exp Is Nothing Then
                '                        Dim arrSpliter = "<div class=""poiresultitem"">"
                '                        If html.Length < 0 OrElse Not html.Contains(arrSpliter) OrElse prePage = html Then
                '                            Log("关键字：" & k.Keyword & "未采集到信息,请确认")
                '                            FlagPageEnd = True
                '                        Else
                '                            prePage = html
                '#Region "采集列表页信息"
                '                            Dim items = html.Split({arrSpliter}, StringSplitOptions.RemoveEmptyEntries)
                '                            For i = 1 To items.Count - 1
                '                                Dim item = items(i)
                '                                Dim address As String = ""
                '                                Dim workplane As String = ""
                '                                Dim title As String = ""
                '                                Dim phone As String = ""
                '                                Dim mobile As String = ""
                '                                Dim x As String = 0
                '                                Dim y As String = 0
                '#Region "地址"
                '                                Dim addrSpliter = "data-addr="
                '                                If item.Contains(addrSpliter) Then address = Split(item, addrSpliter)(1).Split({">"}, StringSplitOptions.None)(0)
                '#End Region
                '#Region "坐标"
                '                                Dim xSpliter = "data-epointx="
                '                                Dim ySpliter = "data-epointy="
                '                                If item.Contains(xSpliter) Then x = Split(item, xSpliter)(1).Split({" data"}, StringSplitOptions.None)(0)
                '                                If item.Contains(ySpliter) Then y = Split(item, ySpliter)(1).Split({" data"}, StringSplitOptions.None)(0)
                '                                workplane = "X:" & x & "|Y:" & y
                '#End Region
                '#Region "标题"
                '                                Dim titleSpliter = "data-poiname="
                '                                If item.Contains(titleSpliter) Then title = Split(Split(item, titleSpliter)(1), " data")(0)
                '#End Region

                '#Region "手机号"
                '                                'Dim phoneSpliter = """phone"":"""
                '                                'If item.Contains(phoneSpliter) Then mobile = Split(item, phoneSpliter)(1).Split({""""}, StringSplitOptions.None)(0).Trim
                '                                ''座机号
                '                                'Dim telSpliter = """tel"":"""
                '                                'If item.Contains(telSpliter) Then phone = Split(item, telSpliter)(1).Split({""""}, StringSplitOptions.None)(0).Trim
                '#End Region
                '                                'Dim pidSpilter = "primary_uid"":"""
                '                                'Dim uidSpliter = """uid"":"""
                '#Region "访问详情页所需ID(备用，目前不需要,使用时，关闭注释即可)"
                '                                'Dim pid = ""
                '                                'Dim uid = ""
                '                                'If item.Contains(pidSpilter) Then
                '                                '    Dim temp = Split(item, pidSpilter)(1)
                '                                '    pid = Split(temp, """")(0)
                '                                '    If temp.Contains(uidSpliter) Then uid = Split(Split(temp, uidSpliter)(1), """")(0)
                '                                'End If
                '#End Region
                '                                'Debug.Print(address, workplane, phone, mobile)
                '#Region "采集过滤,添加"
                '#End Region
                '                                If FilterResult(title, phone, mobile, address) Then
                '                                    Dim info = New CProductInfo(address, title, workplane, city, k.Keyword, MapMode.TengXun.GetDescription, url, phone, mobile)
                '                                    success += If(info.Add(), 1, 0)
                '                                    UpdateView(info)
                '                                End If
                '                            Next
                '#End Region
                '                            If items.Count <= 1 Then FlagPageEnd = True
                '                            If success = 0 Then FlagPageEnd = True
                '                        End If
                '                    Else
                '                        Log("采集超时异常")
                '                        FlagPageEnd = True
                '                    End If
                '                End If
#End Region
            Loop Until FlagPageEnd
        Next
    End Sub
#End Region
End Class
